Subdirección de Medicina Complementaria (SUMEC-CENSI)
Published
December 11, 2025
Note
Instrucciones: Todos los gráficos a continuación incluyen una pestaña llamada “Datos Fuente”. Haga clic en ella para ver la tabla y descargar la información en Excel.
# 1. Definimos el orden lógico deseadoorden_ciclo <-c("Niño", "Adolescente", "Adulto", "Adulto Mayor")# 2. Definimos los colores específicos (Mapeo Seguro)# F = Fucsia/DeepPink (#FF1493), M = Azul Marino (#000080)colores_sexo <-c("F"="#FF1493", "M"="#000080")# 3. Preparamos los datosperfil_sexo_edad <- df_ind %>%filter(!is.na(ciclo_vida)) %>%mutate(# Forzamos el orden en el gráficociclo_vida =factor(ciclo_vida, levels = orden_ciclo) ) %>%group_by(sexo, ciclo_vida) %>%summarise(Atendidos =n_distinct(ID_paciente), .groups ='drop')# 4. Generamos el gráfico con colores personalizadosplot_ly(perfil_sexo_edad, x =~ciclo_vida, y =~Atendidos, color =~sexo, colors = colores_sexo, # <--- AQUÍ SE APLICA EL COLORtype ='bar') %>%layout(title ="Atendidos Únicos por Etapa de Vida y Sexo", barmode ='group',xaxis =list(title ="Ciclo de Vida"), yaxis =list(title ="Número de Pacientes"),legend =list(title =list(text ="Sexo")) )
# 1. Agrupar por Pacientes Únicosresumen_etnia <- df_sociodemo %>%group_by(Grupo_Etnico) %>%summarise(Atendidos =n_distinct(ID_paciente)) %>%arrange(desc(Atendidos)) # Ordenar de mayor a menor# 2. Gráficoplot_ly(resumen_etnia, x =~Atendidos, y =~reorder(Grupo_Etnico, Atendidos), # Reorder para que salga ordenado visualmentetype ='bar', marker =list(color ='#2c3e50')) %>%# Un color sobrio (azul oscuro grisáceo)layout(title ="Pacientes Únicos según Autoidentificación Étnica",xaxis =list(title ="Número de Pacientes"),yaxis =list(title =""),margin =list(l =150) # Margen izquierdo extra para leer las etiquetas largas )
# 1. Agrupación Doble (Etnia + Financiador)resumen_combinado <- df_sociodemo %>%group_by(Grupo_Etnico, Nombre_Financiador) %>%summarise(Atendidos =n_distinct(ID_paciente), .groups ='drop')# 2. Gráfico de Barras Apiladas (Stacked)plot_ly(resumen_combinado, x =~Atendidos, y =~Grupo_Etnico, color =~Nombre_Financiador, type ='bar') %>%layout(title ="Distribución de Financiador por Grupo Étnico",barmode ='stack', # Apilado para ver la composiciónxaxis =list(title ="Número de Pacientes"),yaxis =list(title ="", categoryorder ="total ascending"), # Ordena las barras por el totallegend =list(title =list(text ="Financiador")) )
#| label: plot-procedimientos-categoria#| warning: false# 1. PROCESAMIENTO: Categorización de Códigosdf_procedimientos <- df_ind %>%mutate(# Aseguramos que codigo sea texto para evitar errores de comparacióncodigo_str =as.character(codigo),Categoria_Procedimiento =case_when( codigo_str %in%c("97810", "97811") ~"Acupuntura", codigo_str %in%c("97813", "97814") ~"Electroacupuntura", codigo_str %in%c("U903") ~"Terapia Mente-cuerpo", codigo_str %in%c("90861") ~"Terapia de relajación", codigo_str %in%c("90880") ~"Sesión de hipnoterapia", codigo_str %in%c("90849") ~"Psicoterapia grupal (múltiples familias)", codigo_str %in%c("90857") ~"Psicoterapia interactiva de grupo", codigo_str %in%c("U900") ~"Terapia Neural", codigo_str %in%c("U902") ~"Reflexología", codigo_str %in%c("U904") ~"Homeopatía", codigo_str %in%c("U907") ~"Terapia Floral", codigo_str %in%c("U908") ~"Bioenergética", codigo_str %in%c("U906") ~"Trofoterapia", codigo_str %in%c("U905") ~"Fitoterapia", codigo_str %in%c("97022") ~"Hidroterapia", codigo_str %in%c("98925", "98926", "98927", "98928", "98929") ~"Osteopatía", codigo_str %in%c("98940", "98941", "98942", "98943") ~"Quiropraxia", codigo_str %in%c("97124") ~"Masoterapia", codigo_str %in%c("Z5102", "U901") ~"Laserterapia", codigo_str %in%c("U080") ~"Consejería en Med. Complem.",TRUE~NA_character_# Todo lo que no esté en la lista será NA ) ) %>%# Filtramos solo los que coincidieron con tu lista (Excluyendo NAs)filter(!is.na(Categoria_Procedimiento))# 2. AGREGACIÓN: Conteo de PERSONAS ÚNICAS (Atendidos)resumen_procedimientos <- df_procedimientos %>%group_by(Categoria_Procedimiento) %>%summarise(Atendidos =n_distinct(ID_paciente)) %>%arrange(desc(Atendidos)) # Ordenar de mayor a menor# 3. VISUALIZACIÓNplot_ly(resumen_procedimientos, x =~Atendidos, y =~reorder(Categoria_Procedimiento, Atendidos), # Ordena las barrastype ='bar', orientation ='h', # Gráfico Horizontal (Mejor para nombres largos)marker =list(color ='#8e44ad')) %>%# Color Violeta/Morado distintivolayout(title ="Personas Atendidas por Tipo de Procedimiento",xaxis =list(title ="Número de Personas Únicas"),yaxis =list(title =""),margin =list(l =150) # Margen izquierdo extra para que se lean los nombres )
# 1. DEFINIR LOS CÓDIGOS DE PROCEDIMIENTOS (Tu lista de exclusión/interés)codigos_interes <-c("97810", "97811", "97813", "97814", "U903", "90861", "90880", "90849", "90857", "U900", "U902", "U904", "U907", "U908", "U906", "U905", "97022", "98925", "98926", "98927", "98928", "98929", "98940", "98941", "98942", "98943", "97124", "Z5102", "U901", "U080")# 2. CREAR UN "DICCIONARIO DE CITAS"# Identificamos qué id_cita tuvo qué procedimiento.# Esto es mucho más rápido que procesar toda la base.diccionario_citas_procedimientos <- df_ind %>%# Nos quedamos solo con las filas que tienen los procedimientos de interésfilter(codigo %in% codigos_interes) %>%mutate(codigo_str =as.character(codigo),# Aplicamos tu categorizaciónCategoria_Procedimiento =case_when( codigo_str %in%c("97810", "97811") ~"Acupuntura", codigo_str %in%c("97813", "97814") ~"Electroacupuntura", codigo_str %in%c("U903") ~"Terapia Mente-cuerpo", codigo_str %in%c("90861") ~"Terapia de relajación", codigo_str %in%c("90880") ~"Sesión de hipnoterapia", codigo_str %in%c("90849") ~"Psicoterapia grupal", codigo_str %in%c("90857") ~"Psicoterapia interactiva", codigo_str %in%c("U900") ~"Terapia Neural", codigo_str %in%c("U902") ~"Reflexologia", codigo_str %in%c("U904") ~"Homeopatia", codigo_str %in%c("U907") ~"Terapia Floral", codigo_str %in%c("U908") ~"Bioenergética", codigo_str %in%c("U906") ~"Trofoterapia", codigo_str %in%c("U905") ~"Fitoterapia", codigo_str %in%c("97022") ~"Hidroterapia", codigo_str %in%c("98925", "98926", "98927", "98928", "98929") ~"Osteopatía", codigo_str %in%c("98940", "98941", "98942", "98943") ~"Quiropraxia", codigo_str %in%c("97124") ~"Masoterapia", codigo_str %in%c("Z5102", "U901") ~"Laserterapia", codigo_str %in%c("U080") ~"Consejeria Med. Comp.",TRUE~"Otro Procedimiento MC" ) ) %>%# Seleccionamos solo las llaves necesariasselect(id_cita, Categoria_Procedimiento) %>%# ¡IMPORTANTE! Si en una cita hicieron 2 procedimientos, esto duplicaría filas.# Nos quedamos con los únicos (o podrías priorizar uno si quisieras)distinct(id_cita, .keep_all =TRUE)# 3. PROPAGACIÓN Y FILTRADOdf_morbilidad_real <- df_ind %>%# A. Unimos con el diccionario (Left Join propagará la categoría a todas las filas de esa cita)left_join(diccionario_citas_procedimientos, by ="id_cita") %>%# B. FILTRADO (Exclusión)filter(# 1. Eliminamos las filas que SON los procedimientos de la lista!codigo %in% codigos_interes,# 2. Aseguramos que lo que queda sea un CIE-10 válido (Empieza con letra)# Esto limpia insumos, labconf u otros códigos numéricos que no sean de tu listastr_detect(codigo, "^[A-Za-z]"),# 3. (Opcional) Nos quedamos solo con las citas que SI tuvieron algun procedimiento MC!is.na(Categoria_Procedimiento) )# --- Verificación ---# Ahora df_morbilidad_real tiene filas como "M545" (Lumbago) # pero con la columna Categoria_Procedimiento llena con "Acupuntura" (si se hizo en esa cita).# 4. CÁLCULO DEL TOP 20top20_diagnosticos <- df_morbilidad_real %>%group_by(codigo) %>%summarise(Pacientes =n_distinct(ID_paciente),# Opcional: Podrías ver cuál fue la terapia más común para este diagnósticoTerapia_Principal =names(which.max(table(Categoria_Procedimiento))) ) %>%arrange(desc(Pacientes)) %>%head(20)# 5. GRÁFICOplot_ly(top20_diagnosticos, x =~Pacientes, y =~reorder(codigo, Pacientes), type ='bar', orientation ='h',marker =list(color ='#c0392b'), # Rojo oscurotext =~paste("CIE-10:", codigo, "<br>Pacientes:", Pacientes,"<br>Terapia Frecuente:", Terapia_Principal),hoverinfo ="text") %>%layout(title ="Top 20 Diagnósticos (Filtrando Procedimientos)",xaxis =list(title ="Número de Pacientes Únicos"),yaxis =list(title ="Código CIE-10"),margin =list(l =100) )
Este gráfico muestra la composición clínica de cada terapia. El tamaño del recuadro representa la cantidad de pacientes.
Code
# 1. PREPARAR DATOS DE LOS "HIJOS" (Diagnósticos)# Agrupamos, contamos y filtramos el Top 5df_hijos <- df_morbilidad_real %>%group_by(Categoria_Procedimiento, codigo) %>%summarise(Pacientes =n_distinct(ID_paciente), .groups ='drop') %>%group_by(Categoria_Procedimiento) %>%slice_max(Pacientes, n =5) %>%# <--- AQUÍ LIMITAMOS A LOS 5 PRIMEROSungroup() %>%mutate(# Creamos un ID único para evitar errores si el M545 se repite en varias terapiasids =paste(Categoria_Procedimiento, codigo, sep ="-"),labels =paste0(codigo, "\n(", format(Pacientes, big.mark=","), ")"),parents = Categoria_Procedimiento # Su padre es la Terapia )# 2. PREPARAR DATOS DE LOS "PADRES" (Las Terapias)# Calculamos la suma de sus hijos (Top 5) para que el tamaño cuadredf_padres <- df_hijos %>%group_by(Categoria_Procedimiento) %>%summarise(Pacientes =sum(Pacientes), .groups ='drop') %>%mutate(ids = Categoria_Procedimiento,labels = Categoria_Procedimiento,parents =""# Los padres no tienen padre (son la raíz) )# 3. UNIR TODO EN UNA SOLA TABLAdf_treemap_final <-bind_rows(df_padres, df_hijos)# 4. GENERAR EL TREEMAP ROBUSTOplot_ly( df_treemap_final,type ="treemap",ids =~ids, # Identificador único técnicolabels =~labels, # Lo que se lee en la cajaparents =~parents, # Quién contiene a quiénvalues =~Pacientes, # Tamaño de la cajabranchvalues ="total", # Importante: fuerza a que el padre sea la suma de hijostextinfo ="label+percent parent",hoverinfo ="label+value+percent parent") %>%layout(title ="Top 5 Diagnósticos por Terapia",margin =list(t=50, l=0, r=0, b=0) )
library(leaflet)library(sf)library(geodata)library(dplyr)# 1. OBTENER GEOMETRÍA DEL PERÚ (Nivel 1 = Departamentos)# 'path = tempdir()' descarga el mapa en una carpeta temporal para no llenar tu proyectomapa_peru_gadm <-gadm(country ="PER", level =1, path =tempdir()) %>%st_as_sf() # Convertimos a formato 'sf' para que leaflet lo entienda fácil# 2. PREPARAR TUS DATOS (Agrupando Lima)data_para_mapa <- df_ind %>%filter(codigo %in% codigos_interes) %>%mutate(# Normalización para cruzar con el mapa de GADMREGION_MAPA =case_when( REGION %in%c("LIMA METROPOLITANA", "LIMA REGIÓN") ~"LIMA", REGION =="SIN INFORMACIÓN"~NA_character_,TRUE~ REGION ) ) %>%filter(!is.na(REGION_MAPA)) %>%group_by(REGION_MAPA) %>%summarise(Pacientes =n_distinct(ID_paciente))# 3. UNIR DATOS CON EL MAPA# GADM trae los nombres en la columna 'NAME_1'peru_mapa_final <- mapa_peru_gadm %>%mutate(name_upper =toupper(NAME_1)) %>%# Convertimos a mayúsculas para el cruceleft_join(data_para_mapa, by =c("name_upper"="REGION_MAPA"))# 4. CREAR PALETA DE COLORESpaleta <-colorBin(palette ="YlOrRd", domain = peru_mapa_final$Pacientes,bins =5,na.color ="#bdc3c7")# 5. GENERAR MAPA LEAFLETleaflet(peru_mapa_final) %>%addProviderTiles(providers$CartoDB.Positron) %>%setView(lng =-75, lat =-9, zoom =5) %>%# PolígonosaddPolygons(fillColor =~paleta(Pacientes),weight =1,opacity =1,color ="white",dashArray ="3",fillOpacity =0.7,# Efecto al pasar el mousehighlightOptions =highlightOptions(weight =3,color ="#666",dashArray ="",fillOpacity =0.7,bringToFront =TRUE),# Etiquetaslabel =~paste0(NAME_1, ": ", format(Pacientes, big.mark=",", na.encode=FALSE)),popup =~paste0("<h4>", NAME_1, "</h4>","<b>Pacientes Atendidos:</b> ", format(Pacientes, big.mark=",", na.encode=FALSE) ) ) %>%# LeyendaaddLegend(pal = paleta, values =~Pacientes, opacity =0.7, title ="Pacientes",position ="bottomright" )
Code
# Tabla simple para descargadata_export_coropletico <- data_para_mapa %>%arrange(desc(Pacientes)) %>%rename(Departamento = REGION_MAPA, Pacientes_Unicos = Pacientes)make_download_table(data_export_coropletico, "Distribucion_Regional_Pacientes")
Footnotes
Etapas de vida:
Niño: Menor de 12 años, Adolescente: Entre 12 a 17 años, Adulto: Entre 18 a 59 años, Adulto mayor: 60 años a más.↩︎